home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / gcl-1.000 / gcl-1 / gcl-1.0 / c / list.d < prev    next >
Encoding:
Text File  |  1994-05-07  |  26.6 KB  |  1,369 lines
  1. /*
  2.  Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa
  3.  
  4. This file is part of GNU Common Lisp, herein referred to as GCL
  5.  
  6. GCL is free software; you can redistribute it and/or modify it under
  7. the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by
  8. the Free Software Foundation; either version 2, or (at your option)
  9. any later version.
  10.  
  11. GCL is distributed in the hope that it will be useful, but WITHOUT
  12. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public 
  14. License for more details.
  15.  
  16. You should have received a copy of the GNU Library General Public License 
  17. along with GCL; see the file COPYING.  If not, write to the Free Software
  18. Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19. */
  20.  
  21. /*
  22.     list.d
  23.  
  24.     list manipulating routines
  25. */
  26.  
  27. #include "include.h"
  28.  
  29. #undef endp
  30.  
  31. #define    endp(obje)    ((enum type)((endp_temp = (obje))->d.t) == t_cons ? \
  32.              FALSE : endp_temp == Cnil ? TRUE : \
  33.              (bool)FEwrong_type_argument(Slist, endp_temp))
  34.  
  35. object endp_temp;
  36.  
  37.  
  38. object Kinitial_element;
  39.  
  40. object test_function;
  41. object item_compared;
  42. bool (*tf)();
  43. #define    TEST(x)        (*tf)(x)
  44.  
  45. object key_function;
  46. object (*kf)();
  47.  
  48. #define    saveTEST  \
  49.     object old_test_function = test_function;  \
  50.     object old_item_compared = item_compared;  \
  51.     bool (*old_tf)() = tf;  \
  52.     object old_key_function = key_function;  \
  53.     object (*old_kf)() = kf;  \
  54.     VOL bool eflag = FALSE
  55.  
  56. #define    protectTEST  \
  57.     frs_push(FRS_PROTECT, Cnil);  \
  58.     if (nlj_active) {  \
  59.         eflag = TRUE;  \
  60.         goto L;  \
  61.     }
  62.  
  63. #define    restoreTEST  \
  64. L:  \
  65.     frs_pop();  \
  66.     test_function = old_test_function;  \
  67.     item_compared = old_item_compared;  \
  68.     tf = old_tf;  \
  69.     key_function = old_key_function;  \
  70.     kf = old_kf;  \
  71.     if (eflag) {  \
  72.         nlj_active = FALSE;  \
  73.         unwind(nlj_fr, nlj_tag);  \
  74.     }
  75.  
  76. bool
  77. test_compare(x)
  78. object x;
  79. {
  80.     object b;
  81.  
  82.     vs_push((*kf)(x));
  83.     b = ifuncall2(test_function, item_compared, vs_head);
  84.     vs_pop;
  85.     return(b != Cnil);
  86. }
  87.  
  88. bool
  89. test_compare_not(x)
  90. object x;
  91. {
  92.     object b;
  93.  
  94.     vs_push((*kf)(x));
  95.     b = ifuncall2(test_function, item_compared, vs_head);
  96.     vs_pop;
  97.     return(b == Cnil);
  98. }
  99.  
  100. bool
  101. test_eql(x)
  102. object x;
  103. {
  104.     return(eql(item_compared, (*kf)(x)));
  105. }
  106.  
  107. object
  108. apply_key_function(x)
  109. object x;
  110. {
  111.     return(ifuncall1(key_function, x));
  112. }
  113.  
  114. object
  115. identity(x)
  116. object x;
  117. {
  118.     return(x);
  119. }
  120.  
  121. setupTEST(item, test, test_not, key)
  122. object item, test, test_not, key;
  123. {
  124.     item_compared = item;
  125.     if (test != Cnil) {
  126.         if (test_not != Cnil)
  127.             FEerror("Both :TEST and :TEST-NOT are specified.", 0);
  128.         test_function = test;
  129.         tf = test_compare;
  130.     } else if (test_not != Cnil) {
  131.         test_function = test_not;
  132.         tf = test_compare_not;
  133.     } else
  134.         tf = test_eql;
  135.     if (key != Cnil) {
  136.         key_function = key;
  137.         kf = apply_key_function;
  138.     } else
  139.         kf = identity;
  140. }
  141.  
  142. #define    PREDICATE(f, f_if, f_if_not, n)  \
  143. f_if()  \
  144. {  \
  145.     if (vs_top - vs_base < n)  \
  146.         too_few_arguments();  \
  147.     vs_push(Ktest);  \
  148.     vs_push(Sfuncall);  \
  149.     f();  \
  150. }  \
  151. \
  152. f_if_not()  \
  153. {  \
  154.     if (vs_top - vs_base < n)  \
  155.         too_few_arguments();  \
  156.     vs_push(Ktest_not);  \
  157.     vs_push(Sfuncall);  \
  158.     f();  \
  159. }
  160.  
  161. bool
  162. endp1(x)
  163. object x;
  164. {
  165.     if (type_of(x) == t_cons)
  166.         return(FALSE);
  167.     else if (x == Cnil)
  168.         return(TRUE);
  169.     vs_push(x);
  170.     FEwrong_type_argument(Slist, x);
  171. }
  172.  
  173. object
  174. car(x)
  175. object x;
  176. {
  177.     if (x == Cnil)
  178.         return(x);
  179.     if (type_of(x) == t_cons)
  180.         return(x->c.c_car);
  181.     FEwrong_type_argument(Slist, x);
  182. }
  183.  
  184. object
  185. cdr(x)
  186. object x;
  187. {
  188.     if (x == Cnil)
  189.         return(x);
  190.     if (type_of(x) == t_cons)
  191.         return(x->c.c_cdr);
  192.     FEwrong_type_argument(Slist, x);
  193. }
  194.  
  195. object
  196. kar(x)
  197. object x;
  198. {
  199.     if (type_of(x) == t_cons)
  200.         return(x->c.c_car);
  201.     FEwrong_type_argument(Scons, x);
  202. }
  203.  
  204. object
  205. kdr(x)
  206. object x;
  207. {
  208.     if (type_of(x) == t_cons)
  209.         return(x->c.c_cdr);
  210.     FEwrong_type_argument(Scons, x);
  211. }
  212.  
  213. stack_cons()
  214. {
  215.     object c;
  216.  
  217.     c = alloc_object(t_cons);
  218.     c->c.c_cdr = vs_pop;
  219.     c->c.c_car = vs_pop;
  220.     *vs_top++ = c;
  221. }
  222.  
  223. #include <varargs.h>
  224.  
  225.  
  226. object on_stack_list_vector(n,ap)
  227.      int n;
  228.      object *ap;
  229. {object res=(object) alloca_val;
  230.  struct cons *p;
  231.  object x;
  232.  p=(struct cons *) res;
  233.  if (n<=0) return Cnil;
  234.  TOP:
  235.  p->t = (int)t_cons;
  236.  p->m=FALSE;
  237.  p->c_car= *(ap++);
  238.  if (--n == 0)
  239.    {p->c_cdr = Cnil;
  240.     return res;}
  241.  else
  242.    { x= (object) p;
  243.      x->c.c_cdr= (object) ( ++p);}
  244.  goto TOP;
  245. }
  246.  
  247. object list_vector(n,ap)
  248.      int n;
  249.      va_list ap;
  250. {object ans,*p;
  251.  
  252.  if (n == 0) return Cnil;
  253.  ans = make_cons(va_arg(ap,object),Cnil);
  254.  p = & (ans->c.c_cdr); 
  255.  while (--n > 0)
  256.    { *p = make_cons(va_arg(ap,object),Cnil);
  257.      p = & ((*p)->c.c_cdr);
  258.    }
  259.  return ans;}
  260.  
  261.    
  262.  
  263. object on_stack_list(n, va_alist)
  264. int n;
  265. va_dcl
  266. {va_list ap;
  267.  object *new;
  268.  va_start(ap);
  269.  {COERCE_VA_LIST(new,ap,n);
  270.  return on_stack_list_vector(n,new);}
  271.  va_end(ap);
  272. }
  273.  
  274.    
  275.  
  276. object list(n, va_alist)
  277. int n;
  278. va_dcl
  279. { va_list ap;
  280.   struct typemanager *tm=(&tm_table[(int)t_cons]);
  281.   va_start(ap);
  282.   if (tm->tm_nfree < n || interrupt_flag)
  283.      {
  284.     object *p = vs_top;
  285.  
  286.     vs_push(Cnil);
  287.     while(--n>=0)
  288.       { *p=make_cons(va_arg(ap,object),Cnil);
  289.         p= &((*p)->c.c_cdr);
  290.       }
  291.     return(vs_pop);
  292.      }
  293.   else
  294.     {int i=0;
  295.     object tail=tm->tm_free;
  296.     object lis;
  297.     tm->tm_nfree -= n;
  298.     tm->tm_nused += n;
  299.     n=n-1;
  300.     lis=tail;
  301.     while (1)
  302.       {if (i < n)
  303.        tail->c.c_cdr=((struct freelist *)tail)->f_link;
  304.        else {tm->tm_free=((struct freelist *)tail)->f_link;
  305.          tail->d.t = (int)t_cons;
  306.          tail->d.m = FALSE;
  307.          tail->c.c_car=va_arg(ap,object); 
  308.          tail->c.c_cdr=Cnil;
  309.          return lis;
  310.        }
  311.        /* these could be one instruction*/
  312.        tail->d.t = (int)t_cons;
  313.        tail->d.m=FALSE;
  314.        tail->c.c_car=va_arg(ap,object);
  315.        tail=tail->c.c_cdr;
  316.        i++;}}
  317.   va_end(ap);
  318.  
  319. }
  320.  
  321. object listA(n, va_alist)
  322. int n;
  323. va_dcl
  324. {       va_list ap;
  325.     object *p = vs_top;
  326.     va_start(ap);
  327.     vs_push(Cnil);
  328.     while(--n>0)
  329.       { *p=make_cons(va_arg(ap,object),Cnil);
  330.         p= &((*p)->c.c_cdr);
  331.       }
  332.     *p=va_arg(ap,object);
  333.     va_end(ap);
  334.     return(vs_pop);
  335. }
  336.  
  337. bool
  338. tree_equal(x, y)
  339. object x, y;
  340. {
  341.     cs_check(x);
  342.  
  343. BEGIN:
  344.     if (type_of(x) == t_cons)
  345.         if (type_of(y) == t_cons)
  346.             if (tree_equal(x->c.c_car, y->c.c_car)) {
  347.                 x = x->c.c_cdr;
  348.                 y = y->c.c_cdr;
  349.                 goto BEGIN;
  350.             } else
  351.                 return(FALSE);
  352.         else
  353.             return(FALSE);
  354.     else {
  355.         item_compared = x;
  356.         if (TEST(y))
  357.             return(TRUE);
  358.         else
  359.             return(FALSE);
  360.     }
  361. }
  362.  
  363. object
  364. append(x, y)
  365. object x, y;
  366. {
  367.     object z;
  368.  
  369.     if (endp(x))
  370.         return(y);
  371.     z = make_cons(Cnil, Cnil);
  372.     vs_push(z);
  373.     for (;;) {
  374.         z->c.c_car = x->c.c_car;
  375.         x = x->c.c_cdr;
  376.         if (endp(x))
  377.             break;
  378.         z->c.c_cdr = make_cons(Cnil, Cnil);
  379.         z = z->c.c_cdr;
  380.     }
  381.     z->c.c_cdr = y;
  382.     return(vs_pop);
  383. }
  384.  
  385. /*
  386.     Copy_list(x) copies list x.
  387. */
  388. object
  389. copy_list(x)
  390. object x;
  391. {
  392.     object y;
  393.  
  394.     if (type_of(x) != t_cons)
  395.         return(x);
  396.     y = make_cons(x->c.c_car, Cnil);
  397.     vs_push(y);
  398.     for (x = x->c.c_cdr; type_of(x) == t_cons; x = x->c.c_cdr) {
  399.         y->c.c_cdr = make_cons(x->c.c_car, Cnil);
  400.         y = y->c.c_cdr;
  401.     }
  402.     y->c.c_cdr = x;
  403.     return(vs_pop);
  404. }
  405.  
  406. /*
  407.     Copy_alist(x) copies alist x.
  408. */
  409. object
  410. copy_alist(x)
  411. object x;
  412. {
  413.     object y;
  414.  
  415.     if (endp(x))
  416.         return(Cnil);
  417.     y = make_cons(Cnil, Cnil);
  418.     vs_push(y);
  419.     for (;;) {
  420.         y->c.c_car = make_cons(car(x->c.c_car), cdr(x->c.c_car));
  421.         x = x->c.c_cdr;
  422.         if (endp(x))
  423.             break;
  424.         y->c.c_cdr = make_cons(Cnil, Cnil);
  425.         y = y->c.c_cdr;
  426.     }
  427.     return(vs_pop);
  428. }
  429.  
  430. /*
  431.     Copy_tree(x) copies tree x
  432.     and pushes the result onto vs.
  433. */
  434. copy_tree(x)
  435. object x;
  436. {
  437.     cs_check(x);
  438.  
  439.     if (type_of(x) == t_cons) {
  440.         copy_tree(x->c.c_car);
  441.         copy_tree(x->c.c_cdr);
  442.         stack_cons();
  443.     } else
  444.         vs_check_push(x);
  445. }
  446.  
  447. /*
  448.     Subst(new, tree) pushes
  449.     the result of substituting new in tree
  450.     onto vs.
  451. */
  452. subst(new, tree)
  453. object new, tree;
  454. {
  455.     cs_check(new);
  456.  
  457.     if (TEST(tree))
  458.         vs_check_push(new);
  459.     else if (type_of(tree) == t_cons) {
  460.         subst(new, tree->c.c_car);
  461.         subst(new, tree->c.c_cdr);
  462.         stack_cons();
  463.     } else
  464.         vs_check_push(tree);
  465. }
  466.  
  467. /*
  468.     Nsubst(new, treep) stores
  469.     the result of nsubstituting new in *treep
  470.     to *treep.
  471. */
  472. nsubst(new, treep)
  473. object new, *treep;
  474. {
  475.     cs_check(new);
  476.  
  477.     if (TEST(*treep))
  478.         *treep = new;
  479.     else if (type_of(*treep) == t_cons) {
  480.         nsubst(new, &(*treep)->c.c_car);
  481.         nsubst(new, &(*treep)->c.c_cdr);
  482.     }
  483. }
  484.  
  485. /*
  486.     Sublis(alist, tree) pushes
  487.     result of substituting tree by alist
  488.     onto vs.
  489. */
  490. sublis(alist, tree)
  491. object alist, tree;
  492. {
  493.     object x;
  494.  
  495.     cs_check(alist);
  496.  
  497.     for (x = alist;  !endp(x);  x = x->c.c_cdr) {
  498.         item_compared = car(x->c.c_car);
  499.         if (TEST(tree)) {
  500.             vs_check_push(cdr(x->c.c_car));
  501.             return;
  502.         }
  503.     }
  504.     if (type_of(tree) == t_cons) {
  505.         sublis(alist, tree->c.c_car);
  506.         sublis(alist, tree->c.c_cdr);
  507.         stack_cons();
  508.     } else
  509.         vs_check_push(tree);
  510. }
  511.  
  512. /*
  513.     Nsublis(alist, treep) stores
  514.     the result of substiting *treep by alist
  515.     to *treep.
  516. */
  517. nsublis(alist, treep)
  518. object alist, *treep;
  519. {
  520.     object x;
  521.  
  522.     cs_check(alist);
  523.  
  524.     for (x = alist;  !endp(x);  x = x->c.c_cdr) {
  525.         item_compared = car(x->c.c_car);
  526.         if (TEST(*treep)) {
  527.             *treep = x->c.c_car->c.c_cdr;
  528.             return;
  529.         }
  530.     }
  531.     if (type_of(*treep) == t_cons) {
  532.         nsublis(alist, &(*treep)->c.c_car);
  533.         nsublis(alist, &(*treep)->c.c_cdr);
  534.     }
  535. }
  536.  
  537. Lcar()
  538. {
  539.     check_arg(1);
  540.  
  541.     if (type_of(vs_base[0]) == t_cons || vs_base[0] == Cnil)
  542.         vs_base[0] = vs_base[0]->c.c_car;
  543.     else
  544.         FEwrong_type_argument(Slist, vs_base[0]);
  545. }
  546.  
  547. Lcdr()
  548. {
  549.     check_arg(1);
  550.  
  551.     if (type_of(vs_base[0]) == t_cons || vs_base[0] == Cnil)
  552.         vs_base[0] = vs_base[0]->c.c_cdr;
  553.     else
  554.         FEwrong_type_argument(Slist, vs_base[0]);
  555. }
  556.     
  557. object caar(x) object x;    {  return(car(car(x)));  }
  558. object cadr(x) object x;    {  return(car(cdr(x)));  }
  559. object cdar(x) object x;    {  return(cdr(car(x)));  }
  560. object cddr(x) object x;    {  return(cdr(cdr(x)));  }
  561. object caaar(x) object x;   {  return(car(car(car(x))));  }
  562. object caadr(x) object x;   {  return(car(car(cdr(x))));  }
  563. object cadar(x) object x;   {  return(car(cdr(car(x))));  }
  564. object caddr(x) object x;   {  return(car(cdr(cdr(x))));  }
  565. object cdaar(x) object x;   {  return(cdr(car(car(x))));  }
  566. object cdadr(x) object x;   {  return(cdr(car(cdr(x))));  }
  567. object cddar(x) object x;   {  return(cdr(cdr(car(x))));  }
  568. object cdddr(x) object x;   {  return(cdr(cdr(cdr(x))));  }
  569. object caaaar(x) object x;  {  return(car(car(car(car(x)))));  }
  570. object caaadr(x) object x;  {  return(car(car(car(cdr(x)))));  }
  571. object caadar(x) object x;  {  return(car(car(cdr(car(x)))));  }
  572. object caaddr(x) object x;  {  return(car(car(cdr(cdr(x)))));  }
  573. object cadaar(x) object x;  {  return(car(cdr(car(car(x)))));  }
  574. object cadadr(x) object x;  {  return(car(cdr(car(cdr(x)))));  }
  575. object caddar(x) object x;  {  return(car(cdr(cdr(car(x)))));  }
  576. object cadddr(x) object x;  {  return(car(cdr(cdr(cdr(x)))));  }
  577. object cdaaar(x) object x;  {  return(cdr(car(car(car(x)))));  }
  578. object cdaadr(x) object x;  {  return(cdr(car(car(cdr(x)))));  }
  579. object cdadar(x) object x;  {  return(cdr(car(cdr(car(x)))));  }
  580. object cdaddr(x) object x;  {  return(cdr(car(cdr(cdr(x)))));  }
  581. object cddaar(x) object x;  {  return(cdr(cdr(car(car(x)))));  }
  582. object cddadr(x) object x;  {  return(cdr(cdr(car(cdr(x)))));  }
  583. object cdddar(x) object x;  {  return(cdr(cdr(cdr(car(x)))));  }
  584. object cddddr(x) object x;  {  return(cdr(cdr(cdr(cdr(x)))));  }
  585.  
  586. Lcaar(){  check_arg(1);  vs_base[0] = car(car(vs_base[0]));  }
  587. Lcadr(){  check_arg(1);  vs_base[0] = car(cdr(vs_base[0]));  }
  588. Lcdar(){  check_arg(1);  vs_base[0] = cdr(car(vs_base[0]));  }
  589. Lcddr(){  check_arg(1);  vs_base[0] = cdr(cdr(vs_base[0]));  }
  590. Lcaaar(){  check_arg(1);  vs_base[0] = car(car(car(vs_base[0])));  }
  591. Lcaadr(){  check_arg(1);  vs_base[0] = car(car(cdr(vs_base[0])));  }
  592. Lcadar(){  check_arg(1);  vs_base[0] = car(cdr(car(vs_base[0])));  }
  593. Lcaddr(){  check_arg(1);  vs_base[0] = car(cdr(cdr(vs_base[0])));  }
  594. Lcdaar(){  check_arg(1);  vs_base[0] = cdr(car(car(vs_base[0])));  }
  595. Lcdadr(){  check_arg(1);  vs_base[0] = cdr(car(cdr(vs_base[0])));  }
  596. Lcddar(){  check_arg(1);  vs_base[0] = cdr(cdr(car(vs_base[0])));  }
  597. Lcdddr(){  check_arg(1);  vs_base[0] = cdr(cdr(cdr(vs_base[0])));  }
  598. Lcaaaar(){check_arg(1); vs_base[0] = car(car(car(car(vs_base[0]))));}
  599. Lcaaadr(){check_arg(1); vs_base[0] = car(car(car(cdr(vs_base[0]))));}
  600. Lcaadar(){check_arg(1); vs_base[0] = car(car(cdr(car(vs_base[0]))));}
  601. Lcaaddr(){check_arg(1); vs_base[0] = car(car(cdr(cdr(vs_base[0]))));}
  602. Lcadaar(){check_arg(1); vs_base[0] = car(cdr(car(car(vs_base[0]))));}
  603. Lcadadr(){check_arg(1); vs_base[0] = car(cdr(car(cdr(vs_base[0]))));}
  604. Lcaddar(){check_arg(1); vs_base[0] = car(cdr(cdr(car(vs_base[0]))));}
  605. Lcadddr(){check_arg(1); vs_base[0] = car(cdr(cdr(cdr(vs_base[0]))));}
  606. Lcdaaar(){check_arg(1); vs_base[0] = cdr(car(car(car(vs_base[0]))));}
  607. Lcdaadr(){check_arg(1); vs_base[0] = cdr(car(car(cdr(vs_base[0]))));}
  608. Lcdadar(){check_arg(1); vs_base[0] = cdr(car(cdr(car(vs_base[0]))));}
  609. Lcdaddr(){check_arg(1); vs_base[0] = cdr(car(cdr(cdr(vs_base[0]))));}
  610. Lcddaar(){check_arg(1); vs_base[0] = cdr(cdr(car(car(vs_base[0]))));}
  611. Lcddadr(){check_arg(1); vs_base[0] = cdr(cdr(car(cdr(vs_base[0]))));}
  612. Lcdddar(){check_arg(1); vs_base[0] = cdr(cdr(cdr(car(vs_base[0]))));}
  613. Lcddddr(){check_arg(1); vs_base[0] = cdr(cdr(cdr(cdr(vs_base[0]))));}
  614.  
  615. static int nth_count;
  616.  
  617. Lenth()
  618. {
  619.     check_arg(1);
  620.  
  621.     vs_base[0] = nth(nth_count, vs_base[0]);
  622. }
  623.  
  624. Lsecond() { nth_count = 1; Lenth(); }
  625. Lthird() { nth_count = 2; Lenth(); }
  626. Lfourth() { nth_count = 3; Lenth(); }
  627. Lfifth() { nth_count = 4; Lenth(); }
  628. Lsixth() { nth_count = 5; Lenth(); }
  629. Lseventh() { nth_count = 6; Lenth(); }
  630. Leighth() { nth_count = 7; Lenth(); }
  631. Lninth() { nth_count = 8; Lenth(); }
  632. Ltenth() { nth_count = 9; Lenth(); }
  633.  
  634. Lcons()
  635. {
  636.     object x;
  637.  
  638.     check_arg(2);
  639.     x = alloc_object(t_cons);
  640.     x->c.c_car = vs_base[0];
  641.     x->c.c_cdr = vs_base[1];
  642.     vs_base[0] = x;
  643.     vs_pop;
  644. }
  645.  
  646. @(defun tree_equal (x y &key test test_not)
  647.         saveTEST;
  648. @
  649.     protectTEST;    
  650.     setupTEST(Cnil, test, test_not, Cnil);
  651.         x=(tree_equal(x, y) ? Ct : Cnil);
  652.         restoreTEST;
  653.         @(return x) 
  654. @)
  655.  
  656. Lendp()
  657. {
  658.     check_arg(1);
  659.  
  660.     if (vs_base[0] == Cnil) {
  661.         vs_base[0] = Ct;
  662.         return;
  663.     }
  664.     if (type_of(vs_base[0]) == t_cons) {
  665.         vs_base[0] = Cnil;
  666.         return;
  667.     }
  668.     FEwrong_type_argument(Slist, vs_base[0]);
  669. }
  670.  
  671. Llist_length()
  672. {
  673.     int n;
  674.     object fast, slow;
  675.  
  676.     check_arg(1);
  677.     n = 0;
  678.     fast = slow = vs_base[0];
  679.     for (;;) {
  680.         if (endp(fast)) {
  681.             vs_base[0] = make_fixnum(n);
  682.             return;
  683.         }
  684.         if (endp(fast->c.c_cdr)) {
  685.             vs_base[0] = make_fixnum(n + 1);
  686.             return;
  687.         }
  688.         if (fast == slow && n > 0) {
  689.             vs_base[0] = Cnil;
  690.             return;
  691.         }
  692.         n += 2;
  693.         fast = fast->c.c_cdr->c.c_cdr;
  694.         slow = slow->c.c_cdr;
  695.     }
  696. }
  697.  
  698. Lnth()
  699. {
  700.     check_arg(2);
  701.     vs_base[0] = nth(fixint(vs_base[0]), vs_base[1]);
  702.     vs_pop;
  703. }
  704.  
  705. object
  706. nth(n, x)
  707. int n;
  708. object x;
  709. {
  710.     if (n < 0) {
  711.         vs_push(make_fixnum(n));
  712.         FEerror("Negative index: ~D.", 1, vs_head);
  713.     }
  714.     while (n-- > 0)
  715.         if (endp(x)) {
  716.             return(Cnil);
  717.         } else
  718.             x = x->c.c_cdr;
  719.     if (endp(x))
  720.         return(Cnil);
  721.     else
  722.         return(x->c.c_car);
  723. }
  724.  
  725. Lnthcdr()
  726. {
  727.     check_arg(2);
  728.     vs_base[0] = nthcdr(fixint(vs_base[0]), vs_base[1]);
  729.     vs_pop;
  730. }
  731.  
  732. object
  733. nthcdr(n, x)
  734. int n;
  735. object x;
  736. {
  737.     if (n < 0) {
  738.         vs_push(make_fixnum(n));
  739.         FEerror("Negative index: ~D.", 1, vs_head);
  740.     }
  741.     while (n-- > 0)
  742.         if (endp(x)) {
  743.             return(Cnil);
  744.         } else
  745.             x = x->c.c_cdr;
  746.     return(x);
  747. }
  748.  
  749. Llast()
  750. {
  751.     check_arg(1);
  752.     if (endp(vs_base[0]))
  753.         return;
  754.         while (type_of(vs_base[0]->c.c_cdr) == t_cons)
  755.         vs_base[0] = vs_base[0]->c.c_cdr;
  756. }
  757.  
  758. Llist()
  759. {
  760.     vs_push(Cnil);
  761.     while (vs_top > vs_base + 1)
  762.         stack_cons();
  763. }
  764.  
  765. LlistA()
  766. {
  767.     if (vs_top == vs_base)
  768.         too_few_arguments();
  769.     while (vs_top > vs_base + 1)
  770.         stack_cons();
  771. }
  772. object copy_off_stack_tree(x)
  773. object x;
  774. #define inheap(x) ((char *)(x) < heap_end) 
  775. {object *p;
  776.  p = &x;
  777.  TOP:
  778.  if (type_of(*p) ==t_cons)
  779.    { if(!inheap(*p))
  780.        *p=make_cons(copy_off_stack_tree((*p)->c.c_car),(*p)->c.c_cdr);
  781.    else
  782.      (*p)->c.c_car = copy_off_stack_tree((*p)->c.c_car);
  783.      p = &((*p)->c.c_cdr);
  784.      goto TOP;}
  785.  return x;
  786. }
  787.  
  788.         
  789.  
  790. object on_stack_make_list(n)
  791. int n;
  792. { object res=(object) alloca_val;
  793.  struct cons *p = (struct cons *)res;
  794.  if (n<=0) return Cnil;
  795.   TOP:
  796.  p->t = (int)t_cons;
  797.  p->m=FALSE;
  798.  p->c_car=Cnil;
  799.  if (--n == 0)
  800.    {p->c_cdr = Cnil;
  801.     return res;}
  802.  else
  803.    {object  x= (object) p;
  804.      x->c.c_cdr= (object) ( ++p);}
  805.  goto TOP;
  806. }
  807.  
  808. object make_list(n)
  809. int n;
  810. {object x =Cnil ;
  811.   while (n-- > 0)
  812.     x = make_cons(Cnil, x);
  813.  return x;}
  814.  
  815. @(defun make_list (size &key initial_element &aux x)
  816.     int i;
  817. @
  818.     check_type_non_negative_integer(&size);
  819.     if (type_of(size) != t_fixnum)
  820.         FEerror("Cannot make a list of the size ~D.", 1, size);
  821.     i = fix(size);
  822.     while (i-- > 0)
  823.         x = make_cons(initial_element, x);
  824.     @(return x)
  825. @)
  826.  
  827. Lappend()
  828. {
  829.     object x;
  830.  
  831.     if (vs_top == vs_base) {
  832.         vs_push(Cnil);
  833.         return;
  834.     }
  835.     while (vs_top > vs_base + 1) {
  836.         x = append(vs_top[-2], vs_top[-1]);
  837.         vs_top[-2] = x;
  838.         vs_pop;
  839.     }
  840. }
  841.  
  842. Lcopy_list()
  843. {
  844.     check_arg(1);
  845.     vs_base[0] = copy_list(vs_base[0]);
  846. }
  847.  
  848. Lcopy_alist()
  849. {
  850.     check_arg(1);
  851.     vs_base[0] = copy_alist(vs_base[0]);
  852. }
  853.  
  854. Lcopy_tree()
  855. {
  856.     check_arg(1);
  857.     copy_tree(vs_base[0]);
  858.     vs_base[0] = vs_pop;
  859. }
  860.  
  861. Lrevappend()
  862. {
  863.     object x, y;
  864.  
  865.     check_arg(2);
  866.     y = vs_pop;
  867.     for (x = vs_base[0];  !endp(x);  x = x->c.c_cdr) {
  868.         vs_push(x->c.c_car);
  869.         vs_push(y);
  870.         stack_cons();
  871.         y = vs_pop;
  872.     }
  873.     vs_base[0] = y;
  874. }
  875.  
  876. object
  877. nconc(x, y)
  878. object x, y;
  879. {
  880.     object x1;
  881.  
  882.     if (endp(x))
  883.         return(y);
  884.     for (x1 = x;  !endp(x1->c.c_cdr);  x1 = x1->c.c_cdr)
  885.         ;
  886.     x1->c.c_cdr = y;
  887.     return(x);
  888. }
  889.  
  890. Lnconc()
  891. {
  892.     object x, l, m;
  893.         int i, narg;
  894.     
  895.     narg = vs_top - vs_base - 1;
  896.     if (narg < 0) { vs_push(Cnil); return; }
  897.     x = Cnil;
  898.     for (i = 0;  i < narg;  i++) {
  899.         l = vs_base[i];
  900.         if (endp(l))
  901.             continue;
  902.         if (x == Cnil)
  903.             x = m = l;
  904.         else {
  905.             m->c.c_cdr = l;
  906.             m = l;
  907.         }
  908.         for (;  !endp(m->c.c_cdr);  m = m->c.c_cdr)
  909.             ;
  910.     }
  911.     if (x == Cnil) vs_base[0] = vs_top[-1];
  912.     else {
  913.         m->c.c_cdr = vs_top[-1];
  914.         vs_base[0] = x;
  915.     }
  916.     vs_top = vs_base+1;
  917. }
  918.  
  919. Lreconc()
  920. {
  921.     object x, y, z;
  922.  
  923.     check_arg(2);
  924.     y = vs_pop;
  925.     for (x = vs_base[0];  !endp(x);) {
  926.         z = x;
  927.         x = x->c.c_cdr;
  928.         z->c.c_cdr = y;
  929.         y = z;
  930.     }
  931.     vs_base[0] = y;
  932. }
  933.  
  934. @(defun butlast (lis &optional (nn `make_fixnum(1)`))
  935.     int i;
  936. @
  937.     check_type_non_negative_integer(&nn);
  938.     if (type_of(nn) != t_fixnum)
  939.         @(return Cnil)
  940.     for (i = 0;  !endp(lis);  i++, lis = lis->c.c_cdr)
  941.         vs_check_push(lis->c.c_car);
  942.     if (i <= fix((nn))) {
  943.         vs_top -= i;
  944.         @(return Cnil)
  945.     }
  946.     vs_top -= fix((nn));
  947.     i -= fix((nn));
  948.     vs_push(Cnil);
  949.     while (i-- > 0)
  950.         stack_cons();
  951.     lis = vs_pop;
  952.     @(return lis)
  953. @)
  954.  
  955. @(defun nbutlast (lis &optional (nn `make_fixnum(1)`))
  956.     int i;
  957.     object x;
  958. @
  959.     check_type_non_negative_integer(&nn);
  960.     if (type_of(nn) != t_fixnum)
  961.         @(return Cnil)
  962.     for (i = 0, x = lis;  !endp(x);  i++, x = x->c.c_cdr)
  963.         ;
  964.     if (i <= fix((nn)))
  965.         @(return Cnil)
  966.     for (i -= fix((nn)), x = lis;  --i > 0;  x = x->c.c_cdr)
  967.         ;
  968.     x->c.c_cdr = Cnil;
  969.     @(return lis)
  970. @)
  971.  
  972. Lldiff()
  973. {
  974.     int i;
  975.     object x;
  976.  
  977.     check_arg(2);
  978.     for (i = 0, x = vs_base[0];  !endp(x);  i++, x = x->c.c_cdr)
  979.         if (x == vs_base[1])
  980.             break;
  981.         else
  982.             vs_check_push(x->c.c_car);
  983.     vs_push(Cnil);
  984.     while (i-- > 0)
  985.         stack_cons();
  986.     vs_base[0] = vs_pop;
  987.     vs_pop;
  988. }
  989.  
  990. Lrplaca()
  991. {
  992.     check_arg(2);
  993.     check_type_cons(&vs_base[0]);
  994.     take_care(vs_base[1]);
  995.     vs_base[0]->c.c_car = vs_base[1];
  996.     vs_pop;
  997. }
  998.  
  999. Lrplacd()
  1000. {
  1001.     check_arg(2);
  1002.     check_type_cons(&vs_base[0]);
  1003.     vs_base[0]->c.c_cdr = vs_base[1];
  1004.     vs_pop;
  1005. }
  1006.  
  1007. @(defun subst (new old tree &key test test_not key)
  1008.     saveTEST;
  1009. @
  1010.     protectTEST;
  1011.     setupTEST(old, test, test_not, key);
  1012.     subst(new, tree);
  1013.     tree = vs_pop;
  1014.     restoreTEST;
  1015.     @(return tree)
  1016. @)
  1017.  
  1018. PREDICATE(Lsubst, Lsubst_if, Lsubst_if_not, 3)
  1019.  
  1020.  
  1021. @(defun nsubst (new old tree &key test test_not key)
  1022.     saveTEST;
  1023. @
  1024.     protectTEST;
  1025.     setupTEST(old, test, test_not, key);
  1026.     nsubst(new, &tree);
  1027.     restoreTEST;
  1028.     @(return tree)
  1029. @)
  1030.  
  1031. PREDICATE(Lnsubst, Lnsubst_if, Lnsubst_if_not, 3)
  1032.  
  1033. object
  1034. sublis1(alist,tree,tst)
  1035.      object alist,tree;
  1036.      bool (*tst)();
  1037. {object v;
  1038.  BEGIN:
  1039.  for (v=alist ; v!=Cnil; v=v->c.c_cdr)
  1040.    { if ((*tst)(v->c.c_car->c.c_car ,tree))
  1041.        return(v->c.c_car->c.c_cdr);}
  1042.  if (type_of(tree)==t_cons)
  1043.    {object ntree=make_cons(sublis1(alist,tree->c.c_car,tst),
  1044.                tree->c.c_cdr);
  1045.     ntree->c.c_cdr=sublis1(alist,ntree->c.c_cdr,tst);
  1046.     return ntree;
  1047.   }
  1048.   return tree;
  1049. }
  1050. eq(x,y)
  1051. object x,y;
  1052. {return (x==y);}      
  1053.  
  1054. void
  1055. check_alist(alist)
  1056.      object alist;
  1057. {object v;
  1058.    for (v=alist ; !endp(v) ; v=v->c.c_cdr)
  1059.    {if (type_of(v->c.c_car) != t_cons
  1060.          && v->c.c_car != Cnil)
  1061.  FEerror("Not alist");}
  1062.  return ;
  1063. }
  1064.  
  1065.  
  1066. @(defun sublis (alist tree &key test test_not key)
  1067.  
  1068.         saveTEST;
  1069. @  
  1070.     protectTEST;
  1071.     setupTEST(Cnil, test, test_not, key);
  1072.     sublis(alist, tree);
  1073.     tree = vs_pop;
  1074.     restoreTEST;
  1075.     @(return tree)
  1076. @)
  1077.  
  1078. @(defun nsublis (alist tree &key test test_not key)
  1079.     saveTEST;
  1080. @
  1081.     protectTEST;
  1082.     setupTEST(Cnil, test, test_not, key);
  1083.     nsublis(alist, &tree);
  1084.     restoreTEST;
  1085.     @(return tree)
  1086. @)
  1087.  
  1088. @(defun member (item list &key test test_not key)
  1089.     saveTEST;
  1090. @
  1091.     protectTEST;
  1092.     setupTEST(item, test, test_not, key);
  1093.     while (!endp(list)) {
  1094.         if (TEST(list->c.c_car))
  1095.             goto L;
  1096.         list = list->c.c_cdr;
  1097.     }
  1098.     restoreTEST;
  1099.     @(return list)
  1100. @)
  1101.  
  1102. PREDICATE(Lmember, Lmember_if, Lmember_if_not, 2)
  1103.  
  1104. @(defun member1 (item list &key test test_not key)
  1105.     saveTEST;
  1106. @
  1107.     protectTEST;
  1108.     if (key != Cnil)
  1109.         item = ifuncall1(key, item);
  1110.     setupTEST(item, test, test_not, key);
  1111.     while (!endp(list)) {
  1112.         if (TEST(list->c.c_car))
  1113.             goto L;
  1114.         list = list->c.c_cdr;
  1115.     }
  1116.     restoreTEST;
  1117.     @(return list)
  1118. @)
  1119.  
  1120. Ltailp()
  1121. {
  1122.     object x;
  1123.  
  1124.     check_arg(2);
  1125.     for (x = vs_base[1];  !endp(x);  x = x->c.c_cdr)
  1126.         if (x == vs_base[0]) {
  1127.             vs_base[0] = Ct;
  1128.             vs_pop;
  1129.             return;
  1130.         }
  1131.     vs_base[0] = Cnil;
  1132.     vs_pop;
  1133.     return;
  1134. }
  1135.  
  1136. Ladjoin()
  1137. {
  1138.     object *base = vs_base, *top = vs_top;
  1139.  
  1140.     if (vs_top - vs_base < 2)
  1141.         too_few_arguments();
  1142.     while (vs_base < top)
  1143.         vs_push(*vs_base++);
  1144.     Lmember1();
  1145.     if (vs_base[0] == Cnil)
  1146.         base[1] = make_cons(base[0], base[1]);
  1147.     vs_base = base+1;
  1148.     vs_top = base+2;
  1149. }
  1150.  
  1151. Lacons()
  1152. {
  1153.     check_arg(3);
  1154.  
  1155.     vs_base[0] = make_cons(vs_base[0], vs_base[1]);
  1156.     vs_base[0] = make_cons(vs_base[0], vs_base[2]);
  1157.     vs_top -= 2;
  1158. }
  1159.  
  1160. @(defun pairlis (keys data &optional a_list)
  1161.     object *vp, k, d;
  1162. @
  1163.     vp = vs_top + 1;
  1164.     k = keys;
  1165.     d = data;
  1166.     while (!endp(k)) {
  1167.         if (endp(d))
  1168.          FEerror(
  1169.           "The keys ~S and the data ~S are not of the same length",
  1170.           2, keys, data);
  1171.         vs_check_push(make_cons(k->c.c_car, d->c.c_car));
  1172.         k = k->c.c_cdr;
  1173.         d = d->c.c_cdr;
  1174.     }
  1175.     if (!endp(d))
  1176.         FEerror("The keys ~S and the data ~S are not of the same length",
  1177.             2, keys, data);
  1178.     vs_push(a_list);
  1179.     while (vs_top > vp)
  1180.         stack_cons();
  1181.     @(return `vp[-1]`)
  1182. @)
  1183.  
  1184. static object (*car_or_cdr)();
  1185.  
  1186. @(defun assoc_or_rassoc (item a_list &key test test_not key)
  1187.     saveTEST;
  1188. @
  1189.     protectTEST;
  1190.     setupTEST(item, test, test_not, key);
  1191.     while (!endp(a_list)) {
  1192.         if (TEST((*car_or_cdr)(a_list->c.c_car)) &&
  1193.                     a_list->c.c_car != Cnil) {
  1194.             a_list = a_list->c.c_car;
  1195.             goto L;
  1196.         }
  1197.         a_list = a_list->c.c_cdr;
  1198.     }
  1199.     restoreTEST;
  1200.     @(return a_list)
  1201. @)
  1202.  
  1203. Lassoc() { car_or_cdr = car; Lassoc_or_rassoc(); }
  1204. Lrassoc() { car_or_cdr = cdr; Lassoc_or_rassoc(); }
  1205.  
  1206. static bool true_or_false;
  1207.  
  1208. @(defun assoc_or_rassoc_predicate (predicate a_list)
  1209. @
  1210.     while (!endp(a_list)) {
  1211.         if ((ifuncall1(predicate,
  1212.                    (*car_or_cdr)(a_list->c.c_car)) != Cnil)
  1213.             == true_or_false) {
  1214.             @(return `a_list->c.c_car`)
  1215.         }
  1216.         a_list = a_list->c.c_cdr;
  1217.     }
  1218.     @(return a_list)
  1219. @)
  1220.  
  1221. Lassoc_if() { car_or_cdr = car; true_or_false = TRUE; Lassoc_or_rassoc_predicate(); }
  1222. Lassoc_if_not() { car_or_cdr = car; true_or_false = FALSE; Lassoc_or_rassoc_predicate(); }
  1223. Lrassoc_if() { car_or_cdr = cdr; true_or_false = TRUE; Lassoc_or_rassoc_predicate(); }
  1224. Lrassoc_if_not() { car_or_cdr = cdr; true_or_false = FALSE; Lassoc_or_rassoc_predicate(); }
  1225.  
  1226. bool
  1227. member_eq(x, l)
  1228. object x, l;
  1229. {
  1230.     for (;  type_of(l) == t_cons;  l = l->c.c_cdr)
  1231.         if (x == l->c.c_car)
  1232.             return(TRUE);
  1233.     return(FALSE);
  1234. }
  1235.  
  1236. siLmemq()
  1237. {
  1238.     object x, l;
  1239.  
  1240.     check_arg(2);
  1241.  
  1242.     x = vs_base[0];
  1243.     l = vs_base[1];
  1244.  
  1245.     for (;  type_of(l) == t_cons;  l = l->c.c_cdr)
  1246.         if (x == l->c.c_car) {
  1247.             vs_base[0] = l;
  1248.             vs_pop;
  1249.             return;
  1250.         }
  1251.     
  1252.     vs_base[0] = Cnil;
  1253.     vs_pop;
  1254. }
  1255.  
  1256. delete_eq(x, lp)
  1257. object x, *lp;
  1258. {
  1259.     for (;  type_of(*lp) == t_cons;  lp = &(*lp)->c.c_cdr)
  1260.         if ((*lp)->c.c_car == x) {
  1261.             *lp = (*lp)->c.c_cdr;
  1262.             return;
  1263.         }
  1264. }
  1265.  
  1266. init_list_function()
  1267. {
  1268.     Ktest = make_keyword("TEST");
  1269.     Ktest_not = make_keyword("TEST-NOT");
  1270.     Kkey = make_keyword("KEY");
  1271.  
  1272.     Kinitial_element = make_keyword("INITIAL-ELEMENT");
  1273.  
  1274.     make_function("CAR", Lcar);
  1275.     make_function("CDR", Lcdr);
  1276.  
  1277.     make_function("CAAR", Lcaar);
  1278.     make_function("CADR", Lcadr);
  1279.     make_function("CDAR", Lcdar);
  1280.     make_function("CDDR", Lcddr);
  1281.     make_function("CAAAR", Lcaaar);
  1282.     make_function("CAADR", Lcaadr);
  1283.     make_function("CADAR", Lcadar);
  1284.     make_function("CADDR", Lcaddr);
  1285.     make_function("CDAAR", Lcdaar);
  1286.     make_function("CDADR", Lcdadr);
  1287.     make_function("CDDAR", Lcddar);
  1288.     make_function("CDDDR", Lcdddr);
  1289.     make_function("CAAAAR", Lcaaaar);
  1290.     make_function("CAAADR", Lcaaadr);
  1291.     make_function("CAADAR", Lcaadar);
  1292.     make_function("CAADDR", Lcaaddr);
  1293.     make_function("CADAAR", Lcadaar);
  1294.     make_function("CADADR", Lcadadr);
  1295.     make_function("CADDAR", Lcaddar);
  1296.     make_function("CADDDR", Lcadddr);
  1297.     make_function("CDAAAR", Lcdaaar);
  1298.     make_function("CDAADR", Lcdaadr);
  1299.     make_function("CDADAR", Lcdadar);
  1300.     make_function("CDADDR", Lcdaddr);
  1301.     make_function("CDDAAR", Lcddaar);
  1302.     make_function("CDDADR", Lcddadr);
  1303.     make_function("CDDDAR", Lcdddar);
  1304.     make_function("CDDDDR", Lcddddr);
  1305.  
  1306.     make_function("CONS", Lcons);
  1307.     make_function("TREE-EQUAL", Ltree_equal);
  1308.     make_function("ENDP", Lendp);
  1309.     make_function("LIST-LENGTH", Llist_length);
  1310.     make_function("NTH", Lnth);
  1311.  
  1312.     make_function("FIRST", Lcar);
  1313.     make_function("SECOND", Lsecond);
  1314.     make_function("THIRD", Lthird);
  1315.     make_function("FOURTH", Lfourth);
  1316.     make_function("FIFTH", Lfifth);
  1317.     make_function("SIXTH", Lsixth);
  1318.     make_function("SEVENTH", Lseventh);
  1319.     make_function("EIGHTH", Leighth);
  1320.     make_function("NINTH", Lninth);
  1321.     make_function("TENTH", Ltenth);
  1322.  
  1323.     make_function("REST", Lcdr);
  1324.     make_function("NTHCDR", Lnthcdr);
  1325.     make_function("LAST", Llast);
  1326.     make_function("LIST", Llist);
  1327.     make_function("LIST*", LlistA);
  1328.     make_function("MAKE-LIST", Lmake_list);
  1329.     make_function("APPEND", Lappend);
  1330.     make_function("COPY-LIST", Lcopy_list);
  1331.     make_function("COPY-ALIST", Lcopy_alist);
  1332.     make_function("COPY-TREE", Lcopy_tree);
  1333.     make_function("REVAPPEND", Lrevappend);
  1334.     make_function("NCONC", Lnconc);
  1335.     make_function("NRECONC", Lreconc);
  1336.  
  1337.     make_function("BUTLAST", Lbutlast);
  1338.     make_function("NBUTLAST", Lnbutlast);
  1339.     make_function("LDIFF", Lldiff);
  1340.     make_function("RPLACA", Lrplaca);
  1341.     make_function("RPLACD", Lrplacd);
  1342.     make_function("SUBST", Lsubst);
  1343.     make_function("SUBST-IF", Lsubst_if);
  1344.     make_function("SUBST-IF-NOT", Lsubst_if_not);
  1345.     make_function("NSUBST", Lnsubst);
  1346.     make_function("NSUBST-IF", Lnsubst_if);
  1347.     make_function("NSUBST-IF-NOT", Lnsubst_if_not);
  1348.     make_function("SUBLIS", Lsublis);
  1349.     make_function("NSUBLIS", Lnsublis);
  1350.     make_function("MEMBER", Lmember);
  1351.     make_function("MEMBER-IF", Lmember_if);
  1352.     make_function("MEMBER-IF-NOT", Lmember_if_not);
  1353.     make_si_function("MEMBER1", Lmember1);
  1354.     make_function("TAILP", Ltailp);
  1355.     make_function("ADJOIN", Ladjoin);
  1356.  
  1357.     make_function("ACONS", Lacons);
  1358.     make_function("PAIRLIS", Lpairlis);
  1359.     make_function("ASSOC", Lassoc);
  1360.     make_function("ASSOC-IF", Lassoc_if);
  1361.     make_function("ASSOC-IF-NOT", Lassoc_if_not);
  1362.     make_function("RASSOC", Lrassoc);
  1363.     make_function("RASSOC-IF", Lrassoc_if);
  1364.     make_function("RASSOC-IF-NOT", Lrassoc_if_not);
  1365.  
  1366.     make_si_function("MEMQ", siLmemq);
  1367.  
  1368. }
  1369.